home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
NS_ROOT
/
NS_DEMO.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-05-11
|
7KB
|
212 lines
{$R NS_Demo.Res}
Program NS_Demo;
Uses
WinTypes,
WinCRT,
WinProcs,
WObjects,
Strings,
NS_Roots;
Const
TheMenu = 'MainMenu';
id_Run = 199;
id_Brent = 101;
id_Bisection= 102;
id_Newton = 103;
id_Solve = 107;
id_X1 = 109;
id_X2 = 110;
id_Tolerance= 111;
id_IterMax = 112;
id_Iter = 201;
id_RootValue= 113;
id_Error = 114;
id_Result = 115;
cm_TRootsTest = 101;
Type
TTransferRecord = Record
Solve : Array[0..40] of Char;
X1 : Array[0..7] of Char;
X2 : Array[0..7] of Char;
Tolerance : Array[0..8] of Char;
IterMax : Array[0..10] of Char;
Iter : Array[0..10] of Char;
RootValue : Array[0..40] of Char;
Error : Array[0..1] of Char;
Result : Array[0..40] of Char;
Brent : Bool;
Bisection : Bool;
Newton : Bool;
End; {Record}
Var
ABuffer : TTransferRecord;
Type
PTestWindow = ^TTestWindow; {++++++++++++++++++++++++++++++++++++++++++++++}
TTestWindow = object(TWindow)
ADialog : PDialog;
ARadioButton : PRadioButton;
AEdit : PEdit;
Constructor Init(AParent: PWindowsObject; ATitle: PChar);
Procedure TRootsTest(var Msg: TMessage); virtual cm_First + cm_TRootsTest;
end; {Object}
PTestDialog = ^TTestDialog;
TTestDialog = Object(TDialog)
Procedure xx(Var Msg:TMessage); Virtual id_First + id_Run;
End; {Object}
PMyRoots = ^TMyRoots; {++++++++++++++++++++++++++++++++++++++++++++++++++++}
TMyRoots = Object(TRoots)
Function fx(X:TFloatingPoint) : TFloatingPoint; Virtual;
Function fxPrime(X:TFloatingPoint) : TFloatingPoint; Virtual;
End; {Object}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{+++ TMyRoots +++++++++++++++++++++++++++++++++++++++++++++++++++ TMyRoots +++}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
Function TMyRoots.fx;
{*****************************************************************************}
Begin
fx := (2 * x + 3) * (x - 3);
End;
{EndIf}
Function TMyRoots.fxPrime;
{*****************************************************************************}
Begin
fxPrime := 4 * x - 3;
End;
{EndIf}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{+++ TTestWindow +++++++++++++++++++++++++++++++++++++++++++++ TTestWindow +++}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
Constructor TTestWindow.Init(AParent: PWindowsObject; ATitle: PChar);
{*****************************************************************************}
Begin
TWindow.Init(AParent, ATitle);
Attr.Menu := LoadMenu(Hinstance, MakeIntResource(TheMenu));
End;
{EndConstructor}
procedure TTestWindow.TRootsTest(var Msg: TMessage);
{*****************************************************************************}
Begin
ADialog := New(PTestDialog, Init(@Self, 'TROOTS'));
ADialog^.TransferBuffer := @ABuffer;
StrCopy(ABuffer.Solve , 'f(x) = dunno');
StrCopy(ABuffer.X1 , '0.1');
StrCopy(ABuffer.X2 , '4.0');
StrCopy(ABuffer.Tolerance, '1.0e-10');
StrCopy(ABuffer.IterMax , '100');
StrCopy(ABuffer.Iter , '');
StrCopy(ABuffer.RootValue, '');
StrCopy(ABuffer.Error , '0');
StrCopy(ABuffer.Result , '');
ABuffer.Brent := True;
ABuffer.Bisection := False;
ABuffer.Newton := False;
New(AEdit, InitResource(ADialog, id_Solve, SizeOf(ABuffer.Solve)));
New(AEdit, InitResource(ADialog, id_X1, SizeOf(ABuffer.X1)));
New(AEdit, InitResource(ADialog, id_X2, SizeOf(ABuffer.X2)));
New(AEdit, InitResource(ADialog, id_Tolerance, SizeOf(ABuffer.Tolerance)));
New(AEdit, InitResource(ADialog, id_IterMax, SizeOf(ABuffer.IterMax)));
New(AEdit, InitResource(ADialog, id_Iter, SizeOf(ABuffer.Iter)));
New(AEdit, InitResource(ADialog, id_RootValue, SizeOf(ABuffer.RootValue)));
New(AEdit, InitResource(ADialog, id_Error, SizeOf(ABuffer.Error)));
New(AEdit, InitResource(ADialog, id_Result, SizeOf(ABuffer.Result)));
New(ARadioButton, InitResource(ADialog, id_Brent));
New(ARadioButton, InitResource(ADialog, id_Bisection));
New(ARadioButton, InitResource(ADialog, id_Newton));
Application^.ExecDialog(ADialog);
End;
{EndProcedure}
Procedure TTestDialog.xx;
{*****************************************************************************}
Var
ARoot : PMyRoots;
Code : Integer; { Holds the Val (conversion) error code }
dX1 : Real;
dX2 : Real;
dTolerance : Real;
dIterMax : Integer;
Begin
{-----------------------------------------------------------------------}
{ Data from dialog into transfer record. }
{ Data from transfer record to local vars }
{-----------------------------------------------------------------------}
TransferData(tf_GetData);
Val(ABuffer.X1, dX1, Code);
Val(ABuffer.X2, dX2, Code);
Val(ABuffer.Tolerance, dTolerance, Code);
Val(ABuffer.IterMax, dIterMax, Code);
ARoot := New(PMyRoots, Init(dX1, dX2, dTolerance, dIterMax));
If (ABuffer.Brent) Then
Str(ARoot^.BrentRoots:5:2, ABuffer.Result)
Else If (ABuffer.Bisection) Then
Str(ARoot^.BisectionRoots:5:2, ABuffer.Result)
Else If (ABuffer.Newton) Then
Str(ARoot^.NewtonRoots:5:2, ABuffer.Result);
{EndIfCase}
{-----------------------------------------------------------------------}
{ Convert fields to strings }
{ Data from transfer record to dialog }
{-----------------------------------------------------------------------}
Str(ARoot^.X1, ABuffer.X1);
Str(ARoot^.X2, ABuffer.X2);
Str(ARoot^.IterMax, ABuffer.IterMax);
Str(ARoot^.Iter, ABuffer.Iter);
Str(ARoot^.RootValue:5:2, ABuffer.RootValue);
Str(ARoot^.ErrorCode, ABuffer.Error);
TransferData(tf_SetData);
Dispose(ARoot, Done);
End;
{EndProcedure}
{/////////////////////////////////////////////////////////////////////////////}
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
{/////////////////////////////////////////////////////////////////////////////}
Type
TDlgApplication = object(TApplication)
Procedure InitMainWindow; virtual;
End; {Object}
Var
MyApp: TDlgApplication;
Procedure TDlgApplication.InitMainWindow;
{*****************************************************************************}
Begin
MainWindow := New(PTestWindow, Init(nil, 'Natural Systems'));
End;
{EndProcedure}
Begin {=======================================================================}
MyApp.Init('DialTest');
MyApp.Run;
MyApp.Done;
End.